home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / comm3 / getnet12.lha / GetNET.thor < prev    next >
Text File  |  1996-05-06  |  12KB  |  455 lines
  1. /*
  2.  $VER: GetNET.Thor 1.2 (6.5.96)
  3.  by Remco van Hooff
  4. */
  5.  
  6. bbs       = 'Email'        /* your Email system */
  7.  
  8. /* hotlists */
  9. hotlist_amosaic = 'envarc:mosaic/.mosaic-hotlist-default' ; amosaic = 1
  10. hotlist_ibrowse = 'IBrowse:ibrowse-hotlist.html'          ; ibrowse = 1
  11. hotlist_aweb    = 'AWeb:aweb.hotlist'                     ; aweb    = 1
  12. hotlist_voyager = 'Voyager:bookmarks.html'                ; voyager = 1
  13. hotlist_html    = 'path_to_hotlist:hotlist.html'          ; html    = 0
  14.  
  15. /* loop or not */
  16. loop = 0
  17.  
  18. /* don't edit these */
  19. cr = '0d'x
  20. lf = '0a'x
  21. tab= '09'x
  22.  
  23. /* filter chars, expand if you want */
  24.  
  25. /* after the address */
  26. filter.1.1 = cr
  27. filter.1.2 = lf
  28. filter.1.3 = ')'
  29. filter.1.4 = ','
  30. filter.1.5 = "'"
  31. filter.1.6 = '"'
  32. filter.1.7 = ']'
  33. filter.1.8 = '>'
  34. filter.1.9 = '}'
  35. filter.1.10 = '*'
  36. filter.1.count = 10 /* number of filters */
  37.  
  38. /* in front of the address */
  39. filter.2.1 = '('
  40. filter.2.2 = '"'
  41. filter.2.3 = '<'
  42. filter.2.4 = '['
  43. filter.2.5 = '{'
  44. filter.2.6 = ':'
  45. filter.2.7 = "'"
  46. filter.2.8 = tab
  47. filter.2.count = 8
  48.  
  49. tempfile  = 't:temp.tmp'
  50.  
  51. /*--------------------------------------------------------------------------*/
  52. OPTIONS FAILAT 31
  53. p = ADDRESS() || ' ' || SHOW('P',,)
  54. thorport = POS('THOR.',p)
  55. IF thorport > 0 THEN thorport = WORD(SUBSTR(p,thorport),1)
  56. ELSE DO
  57.   SAY 'THOR port not found!'
  58.   EXIT 10
  59. END
  60.  
  61. IF ~SHOW('p', 'BBSREAD') THEN DO
  62.   ADDRESS COMMAND
  63.     "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  64.     "WaitForPort BBSREAD"
  65. END
  66.  
  67. ADDRESS(thorport)
  68. OPTIONS RESULTS
  69.  
  70. CURRENTMSG stem MSG
  71. IF(RC ~= 0) THEN DO
  72.   REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  73.   EXIT
  74. END
  75. msgnum  = MSG.MSGNR
  76. curbbs  = MSG.BBSNAME
  77. curconf = MSG.CONFNAME
  78.  
  79. ADDRESS bbsread READBRMESSAGE BBSNAME '"'curbbs'"' CONFNAME '"'curconf'"' MSGNR msgnum HEADSTEM headtags
  80. IF(RC ~= 0) THEN DO
  81.   REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  82.   EXIT
  83. END
  84. fromname = HEADTAGS.FROMNAME
  85. subj = HEADTAGS.SUBJECT
  86. IF POS('RE:',UPPER(subj)) ~=0 THEN subj = SUBSTR(subj,5)
  87.  
  88. CALL main
  89. EXIT
  90.  
  91. main:
  92.   DROP FOUND. SAVE. NAME.
  93.   REQUESTNOTIFY TEXT '"Choose what kind of addresses to get."' BT '"_HTTP|_Email|_Quit"'
  94.   IF RESULT = 0 THEN EXIT
  95.   IF RESULT = 1 THEN CALL get_http
  96.   IF RESULT = 2 THEN CALL get_email
  97.   IF loop = 1 THEN SIGNAL main
  98. RETURN
  99.  
  100. /* gethttp */
  101. get_http:
  102. SAVEMESSAGE CURRENT FILENAME tempfile NOANSI OVERWRITE
  103. IF(RC ~= 0) THEN DO
  104.   REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  105.   EXIT
  106. END
  107.  
  108. ELSE DO
  109.   CALL gethttp
  110.   CALL listfound
  111.   IF ok = 1 THEN CALL listsave(1)
  112. END
  113. RETURN
  114.  
  115. gethttp:
  116.   CALL OPEN(tmp, tempfile, 'r')
  117.     num = 0
  118.     found.count = 0
  119.     DO WHILE ~EOF(tmp)
  120.       msg = READLN(tmp)
  121.       msg = TRANSLATE(msg, 'hpt', 'HPT')
  122.       PARSE VAR msg . 'ttp://' httpadres .
  123.       IF httpadres ~= '' THEN DO
  124.         lengte = length(httpadres)
  125.         CALL filter(httpadres, lengte,1)
  126.         httpadres = 'http://'||RESULT
  127.         n = 0
  128.         DO i = 1 TO found.count
  129.           IF httpadres ~= found.i THEN n = n +1
  130.         END        
  131.         IF n = found.count THEN DO
  132.           num = num + 1
  133.           found.num = httpadres
  134.           found.count = num
  135.         END
  136.       END
  137.     END
  138.   CALL CLOSE(tmp)
  139.   ADDRESS COMMAND 'delete >nil: 'tempfile
  140. RETURN
  141.  
  142. savehotlist:
  143.   DO i = 1 TO save.count
  144.     IF name.i = '' THEN name.i = subj '('i')'
  145.   END
  146.   IF amosaic = 1 THEN CALL save_amosaic
  147.   IF ibrowse = 1 THEN CALL save_ibrowse
  148.   IF html    = 1 THEN CALL save_html
  149.   IF aweb    = 1 THEN CALL save_aweb
  150.   IF voyager = 1 THEN CALL save_voyager
  151.   IF amosaic+ibrowse+html+aweb+voyager = 0 THEN Requestnotify '"No hotlist(s) selected."' '"_OK"'
  152.   IF loop = 1 THEN SIGNAL main
  153. RETURN
  154.  
  155. save_amosaic:
  156.   IF ~EXISTS(hotlist_amosaic) THEN DO
  157.     Requestnotify '"Amosaic hotlist not found!"' '"_OK"'
  158.     RETURN
  159.   END
  160.   ELSE DO
  161.     dat = DATE()
  162.     PARSE VAR dat dagnr maand jaar
  163.     dag = LEFT(DATE('W', DATE(S), 'S'), 3)
  164.     datum = dag maand dagnr TIME()jaar
  165.     CALL OPEN(htlst,hotlist_amosaic,'a')
  166.     DO i = 1 TO save.count
  167.       CALL WRITELN(htlst,save.i||' '||datum)
  168.       CALL WRITELN(htlst,STRIP(name.i))
  169.     END
  170.     CALL CLOSE(htlst)
  171.   END
  172.   ADDRESS COMMAND 'copy' hotlist_amosaic 'env:mosaic/ quiet'
  173. RETURN
  174.  
  175. save_ibrowse:
  176.   IF ~EXISTS(hotlist_ibrowse) THEN DO
  177.     Requestnotify '"IBrowse hotlist not found!"' '"_OK"'
  178.     RETURN
  179.   END
  180.   ELSE DO
  181.     CALL OPEN(in,hotlist_ibrowse,'r')
  182.     CALL OPEN(out,'t:IBrowse.tmp','w')
  183.       line = READLN(in)
  184.       DO UNTIL line = '<UL>'
  185.         WRITELN(out, line)
  186.         line = READLN(in)
  187.       END
  188.       WRITELN(out, line)
  189.       DO i = 1 TO save.count
  190.         IF savename.i = '' THEN savename.i = destvar.1 '('i')'
  191.         adres = '<LI><A HREF="'||save.i||'">'STRIP(name.i)'</A><br>'
  192.         WRITELN(out, adres)
  193.       END
  194.       DO UNTIL EOF(in)
  195.         rest = readch(in,1048576) /* 1MB should be enough :.) */
  196.         WRITECH(out, rest)
  197.       END
  198.     CALL CLOSE(out)
  199.     CALL CLOSE(in)
  200.     ADDRESS COMMAND 'copy t:ibrowse.tmp' hotlist_ibrowse 'quiet'
  201.     ADDRESS COMMAND 'delete t:ibrowse.tmp quiet'
  202.   END
  203. RETURN
  204.  
  205. save_html:
  206.   IF ~EXISTS(hotlist_html) THEN DO
  207.     Requestnotify '"HTML hotlist not found!"' '"_OK"'
  208.     RETURN
  209.   END
  210.   ELSE DO
  211.     CALL OPEN(htlst,hotlist_html,'a')
  212.     DO i = 1 TO save.count
  213.       CALL WRITELN(htlst,'<LI><A HREF="'save.i'">'STRIP(name.i)'</A><br>')
  214.     END
  215.     CALL CLOSE(htlst)
  216.   END
  217. RETRUN
  218.  
  219. save_aweb:
  220.   IF ~EXISTS(hotlist_aweb) THEN DO
  221.     Requestnotify '"AWeb hotlist not found!"' '"_OK"'
  222.     RETURN
  223.   END
  224.   ELSE DO
  225.     CALL OPEN(htlst,hotlist_aweb,'a')
  226.     DO i = 1 TO save.count
  227.       CALL WRITELN(htlst,save.i)
  228.       CALL WRITELN(htlst,STRIP(name.i))
  229.     END
  230.     CALL CLOSE(htlst)
  231.   END
  232. RETURN
  233.  
  234. save_Voyager:
  235.   IF ~EXISTS(hotlist_voyager) THEN DO
  236.     Requestnotify '"Voyager hotlist not found!"' '"_OK"'
  237.     RETURN
  238.   END
  239.   ELSE DO
  240.     CALL OPEN(in,hotlist_voyager,'r')
  241.     CALL OPEN(out,'t:voyager.tmp','w')
  242.       line = READLN(in)
  243.       DO UNTIL line = '<UL>'
  244.         WRITELN(out, line)
  245.         line = READLN(in)
  246.       END
  247.       WRITELN(out, line)
  248.       DO i = 1 TO save.count
  249.         IF savename.i = '' THEN savename.i = destvar.1 '('i')'
  250.         adres = '<LI><A HREF="'||save.i||'">'STRIP(name.i)'</A><br>'
  251.         WRITELN(out, adres)
  252.       END
  253.       DO UNTIL EOF(in)
  254.         rest = readch(in,1048576) /* 1MB should be enough :.) */
  255.         WRITECH(out, rest)
  256.       END
  257.     CALL CLOSE(out)
  258.     CALL CLOSE(in)
  259.     ADDRESS COMMAND 'copy t:voyager.tmp' hotlist_voyager 'quiet'
  260.     ADDRESS COMMAND 'delete t:voyager.tmp quiet'
  261.   END
  262. RETURN
  263.  
  264. /* end gethttp */
  265.  
  266. /* getemail */
  267. get_email:
  268.   SAVEMESSAGE CURRENT FILENAME tempfile NOHEADER NOANSI OVERWRITE
  269.   IF(RC ~= 0) THEN DO
  270.     'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  271.     EXIT
  272.   END
  273.   ELSE DO
  274.     CALL getemail
  275.     CALL listfound
  276.     IF ok = 1 THEN CALL listsave(2)
  277.   END
  278. RETURN
  279.  
  280. getemail:
  281.   CALL OPEN(tmp, tempfile, 'r')
  282.     num = 0
  283.     found.count = 0
  284.     DO WHILE ~EOF(tmp)
  285.       msg = READLN(tmp)
  286.       PARSE VAR msg part1 '@' part2 '.' part3 rest
  287.       DO FOREVER
  288.         IF (part2 ~= '' & POS(' ',part2) = 0 & part3 ~= '') THEN DO
  289.           spc = LASTPOS(' ', part1)
  290.           IF spc ~= 0 THEN part1 = DELSTR(part1, 1, spc)
  291.           lengte = LENGTH(part1)
  292.           CALL filter(part1,lengte,2)
  293.           part1 = RESULT
  294.           lengte = LENGTH(part3)
  295.           CALL FILTER(part3,lengte,1)
  296.           part3 =  RESULT
  297.           email = part1'@'part2'.'adres
  298.           n = 0
  299.           DO i = 1 TO found.count
  300.             IF email ~= found.i THEN n = n +1
  301.           END        
  302.           IF n = found.count THEN DO
  303.             num = num + 1
  304.             found.num = email
  305.             found.count = num
  306.           END
  307.         END
  308.         IF POS('@', rest) ~= 0 THEN DO
  309.           PARSE VAR rest part1 '@' part2 '.' part3 rest
  310.           empty = 0
  311.         END 
  312.         ELSE empty = 1
  313.         IF empty = 1 THEN LEAVE
  314.       END
  315.     END
  316.   CALL CLOSE(tmp)
  317.   ADDRESS COMMAND 'delete >nil:' tempfile
  318. RETURN
  319.  
  320. userdata:
  321.   IF alias.n = 'ALIAS.'n THEN alias.n = ''
  322.   IF comm.n  = 'COMM.'n  THEN comm.n  = ''
  323.   showdata.1 = 'name    :' name.n
  324.   showdata.2 = 'address :' save.n
  325.   showdata.3 = 'alias   :' alias.n
  326.   showdata.4 = 'comment :' comm.n
  327.   showdata.5 = ''
  328.   showdata.6 = 'RETURN'
  329.   showdata.count = 6
  330.   titel = 'Userdata for' save.n
  331.   REQUESTLIST INSTEM showdata TITLE '"'titel'"' SIZEGADGET
  332.   IF (RC = 30) THEN DO
  333.     REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  334.     EXIT
  335.   END
  336.   IF RC ~= 5 THEN DO
  337.     sel = RESULT
  338.     IF sel = showdata.1 THEN DO
  339.       RESULT = name.n
  340.       REQUESTSTRING TITLE '"Enter a name for"' BT '"_OK|_From:|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'name.n'"'
  341.       IF THORRC = 0 then name.n = ''
  342.       IF THORRC = 1 then name.n = RESULT
  343.       IF THORRC = 2 THEN name.n = fromname
  344.     END
  345.     IF sel = showdata.2 THEN DO
  346.       RESULT = save.n
  347.       REQUESTSTRING TITLE '"Change address"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'save.n'"'
  348.       save.n = RESULT
  349.     END
  350.     IF sel = showdata.3 THEN DO
  351.       RESULT = alias.n
  352.       REQUESTSTRING TITLE '"Enter an alias for"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'alias.n'"'
  353.       alias.n = RESULT
  354.     END
  355.     IF sel = showdata.4 THEN DO
  356.       RESULT = comm.n
  357.       REQUESTSTRING TITLE '"Enter a comment for"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'comm.n'"'
  358.       comm.n = RESULT
  359.     END
  360.     IF sel = 'RETURN' THEN SIGNAL listsave(2)
  361.     SIGNAL userdata
  362.   END
  363.   ELSE SIGNAL main
  364. RETURN
  365.  
  366. save_userdata:
  367.   DROP USER.
  368.   DO i = 1 TO save.count
  369.     IF name.i = '' THEN DO
  370.       PARSE VAR save.i part1 '@'
  371.       name.i = part1
  372.     END
  373.     USER.NAME      = name.i
  374.     USER.ADDRESS   = save.i
  375.     USER.ALIAS     = alias.i
  376.     USER.COMMENT.1 = comm.i
  377.     IF USER.COMMENT.1 = '' THEN USER.COMMENT.COUNT = 0
  378.     ELSE USER.COMMENT.COUNT = 1
  379.     ADDRESS BBSREAD WRITEBRUSER BBSNAME '"'bbs'"' STEM USER ONLYIFEXIST
  380.     IF RC~=0 THEN DO
  381.       REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
  382.       CALL EXIT
  383.     END
  384.   END
  385.   IF loop = 1 THEN SIGNAL main
  386. RETURN
  387. /* end getemail */
  388.  
  389. filter:
  390.   PARSE ARG adres,lngth,fltr
  391.   IF fltr = 2 THEN adres=REVERSE(adres)
  392.   DO i = 1 TO filter.fltr.count
  393.     check = POS(filter.fltr.i, adres)
  394.     IF check ~=0 THEN adres = DELSTR(adres, check)
  395.   END
  396.   punt = LASTPOS('.', adres)
  397.   IF punt ~=0 THEN lngth = length(adres)
  398.   IF (punt = lngth) THEN adres = DELSTR(adres, punt)
  399.   IF fltr = 2 THEN adres=REVERSE(adres)
  400. RETURN(adres)
  401.  
  402. listfound:
  403.   IF found.COUNT > 0 THEN DO
  404.     REQUESTLIST INSTEM found OUTSTEM save TITLE '"Select address(es) to save"' MULTISELECT SIZEGADGET
  405.     IF (RC = 30) THEN DO
  406.       REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  407.       EXIT
  408.     END
  409.     IF RC ~= 5 THEN ok = 1
  410.   END
  411.   IF found.COUNT = 0 THEN DO
  412.     REQUESTNOTIFY '"No addresses found in this message."' '"_Ok"'
  413.     EXIT
  414.   END
  415. RETURN
  416.  
  417. listsave:
  418.   PARSE ARG soort
  419.     DO i = 1 TO save.count
  420.       IF name.i = 'NAME.'i THEN name.i = ''
  421.       showname.i = LEFT(name.i,20,' ')
  422.       show.i = showname.i' - 'save.i
  423.     END
  424.     sep = save.count +1
  425.     but = save.count +2
  426.     show.sep = ''
  427.     show.but = 'SAVE'
  428.     show.count = save.count+2
  429.   IF soort = 1 THEN titel = 'Select to enter a name'
  430.   IF soort = 2 THEN titel = 'Select address to edit userdata'
  431.   REQUESTLIST INSTEM show TITLE '"'titel'"' SIZEGADGET
  432.   IF (RC = 30) THEN DO
  433.     REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  434.     EXIT
  435.   END
  436.   IF RC ~= 5 THEN DO
  437.     selected = RESULT
  438.     IF selected = 'SAVE' THEN DO 
  439.       IF soort = 1 THEN SIGNAL savehotlist
  440.       IF soort = 2 THEN SIGNAL save_userdata
  441.     END
  442.     DO n = 1 TO save.count
  443.       IF selected = show.n THEN DO
  444.         IF soort = 1 THEN DO
  445.           REQUESTSTRING title '"Enter a name"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'name.n'"'
  446.           name.n = RESULT
  447.         END
  448.         IF soort = 2 THEN SIGNAL userdata
  449.       END
  450.     END
  451.     IF soort = 1 THEN SIGNAL listsave(1)
  452.     IF soort = 2 THEN SIGNAL listsave(2)
  453.   END
  454. RETURN
  455.